[PATCH] <short summary of the patch>

TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.

Gbp-Pq: Name Version_2_7_2pre36

diff --git a/Makefile.am b/Makefile.am
index a95e54b1990eb1faff3d675d2c4169afa1248784..44720f396274178e1be949bf75d1786827cf3b98 100644 (file)
--- a/Makefile.am
+++ b/Makefile.am
@@ -259,6 +259,9 @@ unixport/saved_%: | unixport/raw_% unixport/gcl_cmpnopt_%.lsp \
                ( ! echo $@ | grep -q _gprof$$ || echo "(setq compiler::*default-prof-p* t)" >prof_init.lsp ) && \
                echo "(system:save-system \"../$@\")" | \
                cat ../unixport/init_raw.lsp prof_init.lsp - | \
+                       GCL_DISABLE_ASLR=t \
+                       GCL_MULTIPROCESS_MEMORY_POOL= \
+                       GCL_MEM_BOUND=29 \
                        GCL_LSPSYSDIR=../$(srcdir)/unixport/ \
                                ../unixport/raw_$* unixport/ -libdir ./  && \
                rm -f ../unixport/gcl_cmpnopt.lsp
@@ -581,7 +584,7 @@ gcl-tk/%.o: gcl-tk/%.lsp | unixport/saved_ansi_gcl
 CLEANFILES+=gcl-tk/demos/index.lsp gcl-tk/demos/gc-monitor.o
 gcl-tk/demos/index.lsp: gcl-tk/tkl.o | unixport/saved_gcl
        [ -d $(@D) ] || mkdir -p $(@D)
-       cd $(@D) && echo "(load \"../../$<\")(tk::get-autoloads (directory \"*.lisp\"))" | ../../$|
+       cd $(@D) && echo "(load \"../../$<\")(tk::get-autoloads)" | ../../$|
 
 sb_cmpnew/gcl_collectfn.o: cmpnew/gcl_collectfn.lsp | unixport/saved_gcl
        [ -d $(@D) ] || mkdir -p $(@D)

diff --git a/Makefile.in b/Makefile.in
index 7cb6ff4096005b304051d7550b95861f07702ff1..0c0f13e4b6f4f1643575a4b1c80c983c2a9c7959 100644 (file)
--- a/Makefile.in
+++ b/Makefile.in
@@ -4598,6 +4598,9 @@ unixport/saved_%: | unixport/raw_% unixport/gcl_cmpnopt_%.lsp \
                ( ! echo $@ | grep -q _gprof$$ || echo "(setq compiler::*default-prof-p* t)" >prof_init.lsp ) && \
                echo "(system:save-system \"../$@\")" | \
                cat ../unixport/init_raw.lsp prof_init.lsp - | \
+                       GCL_DISABLE_ASLR=t \
+                       GCL_MULTIPROCESS_MEMORY_POOL= \
+                       GCL_MEM_BOUND=29 \
                        GCL_LSPSYSDIR=../$(srcdir)/unixport/ \
                                ../unixport/raw_$* unixport/ -libdir ./  && \
                rm -f ../unixport/gcl_cmpnopt.lsp
@@ -4899,7 +4902,7 @@ gcl-tk/%.o: gcl-tk/%.lsp | unixport/saved_ansi_gcl
        $(word 1,$|) -compile $< -o $@
 gcl-tk/demos/index.lsp: gcl-tk/tkl.o | unixport/saved_gcl
        [ -d $(@D) ] || mkdir -p $(@D)
-       cd $(@D) && echo "(load \"../../$<\")(tk::get-autoloads (directory \"*.lisp\"))" | ../../$|
+       cd $(@D) && echo "(load \"../../$<\")(tk::get-autoloads)" | ../../$|
 
 sb_cmpnew/gcl_collectfn.o: cmpnew/gcl_collectfn.lsp | unixport/saved_gcl
        [ -d $(@D) ] || mkdir -p $(@D)

diff --git a/cmpnew/gcl_cmpeval.lsp b/cmpnew/gcl_cmpeval.lsp
index 1ceffc3aefea5d0f015bfb1e258aaca87fe16e69..e71c456ba648548a41c1a86d867038a21414bcf5 100644 (file)
--- a/cmpnew/gcl_cmpeval.lsp
+++ b/cmpnew/gcl_cmpeval.lsp
@@ -650,7 +650,7 @@
 (defun lit-inl2 (form &aux (lf (eq 'lit (car form))))
   (list (this-safety-level)
        (mapcar (lambda (x) (assert (eq (car x) 'ub)) (third x)) (when lf (fifth form)))
-       (cons (when lf (third form)) (info-type (cadr form)))
+       (cons (when lf (third form)) (ensure-known-type (info-type (cadr form))))
        (ninth form)
        (if lf (remove-comment (fourth form)) "")))
 
@@ -685,12 +685,15 @@
        (let ((i -1)) (mapcan (lambda (x &aux (y (incf i))) (unless (atomic-tp x) (list y))) tps))
        tr)))
 
+(defun tr-unused-tps (tr tps &aux (i -1))
+  (mapcar (lambda (x) (if (member (incf i) tr) t x)) tps))
+
 (defun ?update-fm-propagator (fm cl tr tps)
   (when (symbolp (car cl))
     (when (get (car cl) 'type-propagator);?more
       (when (eq (car fm) 'lit)
        (when (member-if 'integerp tr) ;otherwise no point
-         (push (list (car cl) tr tps) (ninth fm)))))))
+         (push (list (car cl) tr (tr-unused-tps tr tps)) (ninth fm)))))))
 
 (defun merge-inl (cl inl pl &aux (tps (pop inl))(tr (pop inl)))
   (let ((z (member-if (lambda (x) (can-coalesce x tr inl tps)) (car pl))))
@@ -705,7 +708,7 @@
   (mapc (lambda (x) (merge-inl cl x pl)) inls))
 
 (defun ?add-inl (cl fms fm)
-  (let* ((tps (mapcar (lambda (x) (info-type (caddr x))) fms))
+  (let* ((tps (mapcar (lambda (x) (ensure-known-type (info-type (caddr x)))) fms))
         (tr (mapcar (lambda (x &aux (v (car (last x))))
                       (when (and (consp v) (eq (car v) 'var))
                         (position (cddr v) fms :key 'cdddr :test 'equalp)));FIXME
@@ -719,8 +722,6 @@
       (si::string-concatenate "/* " (prin1-to-string form) " */" (remove-comment s))
       s))
 
-(defvar *apply-inl-hash* t)
-
 (defun update-info-type-from-inl (i inl fms &aux (tps (mapcar (lambda (x) (info-type (caddr x))) fms)))
   (setf (info-type i)
        (reduce 'type-and
@@ -745,8 +746,14 @@
     (mapc (lambda (y) (?update-fm-propagator x y tr (caddr y)))
          (sixth inl))))
 
+(defvar *block-apply-inl* nil)
+
+(defun block-apply-inl (cl)
+  (if (listp *block-apply-inl*)
+      (member (car cl) *block-apply-inl*)
+      t))
 
-(defun apply-inl (cl fms &aux (inl (when *apply-inl-hash* (inls-match cl fms))))
+(defun apply-inl (cl fms &aux (inl (unless (block-apply-inl cl) (inls-match cl fms))))
   (when inl
     (let* ((c1fms (mapcar (lambda (x) (cdr (nth x fms))) (second inl))))
       (unless (member-if-not (lambda (x)
@@ -769,7 +776,7 @@
 (defvar *ncompiles* 0)
 
 (defun try-compile (nm s tps
-                   &aux (*sig-discovery* t)
+                   &aux (*sig-discovery* t) si::*sig-discovery-props*
                      *compile-verbose*
                      (syms (mapcar (lambda (x) (declare (ignore x)) (gensym)) tps)))
   (incf *ncompiles*)
@@ -798,7 +805,8 @@
        (car inls)))
 
 (defun iterate-over-inls (nm at &optional (it 0)
-                         &aux (inls (copy-tree (get-inl-list (list nm))))
+                         &aux (*block-apply-inl* (list nm))
+                           (inls (copy-tree (get-inl-list (list nm))))
                            (have-2 (member 2 (car inls) :key 'caddr)))
 
   (flet ((try (s tps chg) ;(print (list 'trying nm s (mapcar 'cmp-unnorm-tp tps)))
@@ -807,6 +815,7 @@
             (print (list nm s (mapcar 'cmp-unnorm-tp tps) chg))
             (return-from iterate-over-inls (iterate-over-inls nm at (1+ it))))))
     (mapc (lambda (inl &aux (tps (copy-list (car inl))))
+           (try (caddr inl) (car inl) (list 'no-mod))
            (when (eql 0 (caddr inl))
              (try 1 (car inl) (list 0 '-> 1)))
            (mapl (lambda (ptp pstp &aux (tp (car ptp))(stp (car pstp)))
@@ -830,6 +839,21 @@
          (car inls))
     it))
 
+(defun seed-all-inls (&aux r)
+  (declare (dynamic-extent r))
+  (do-all-symbols (s)
+    (unless (gethash s *inl-hash*)
+      (when (fboundp s)
+       (unless (or (macro-function s) (special-operator-p s))
+         (when (get-return-type s)
+           (unless (member s r)
+             (pushnew s r)
+             (let ((at (get-arg-types s)))
+             (print s)
+             (try-compile s 0
+                          (make-list (length (ldiff at (member '* at)))
+                                     :initial-element t))))))))))
+
 (defun finalize-inls (nm &aux (*ncompiles* 0)(at (get-arg-types nm))(inls (get-inl-list (list nm))))
   (restrict-inl-1-tps nm at inls)
   (list (iterate-over-inls nm at) *ncompiles*  (show-inls nm)))
@@ -840,12 +864,14 @@
             (unless (zerop (car (finalize-inls x)))
               (setq redo t)))
           *inl-hash*)
-  (when redo
-    (finalize-all-inls)))
+  (when redo (finalize-all-inls)))
+
+(defun finalize-inl-hash nil
+  (seed-all-inls)
+  (finalize-all-inls))
 
 (defun dump-inl-hash (f &optional finalize &aux (si::*print-package* t))
-  (when finalize (finalize-all-inls))
-;  (when compress (maphash (lambda (x y) (declare (ignore y)) (compress-inl x)) *inl-hash*))
+  (when finalize (finalize-inl-hash))
   (with-open-file (s f :direction :output)
     (prin1 '(in-package :compiler) s)
     (terpri s)

diff --git a/cmpnew/gcl_cmptype.lsp b/cmpnew/gcl_cmptype.lsp
index b489f6a0c972bc680c6e2a4e04c49af7a2011c43..f14a1be4dd9730f0adb1e759305fc77ccfa52f4e 100644 (file)
--- a/cmpnew/gcl_cmptype.lsp
+++ b/cmpnew/gcl_cmptype.lsp
@@ -871,7 +871,8 @@
 (si::putprop 'random 'random-propagator 'type-propagator)
 
 (defun lgcd2-propagator (f t1 t2 t3
-                        &aux (a1 (car (atomic-tp t1)))(a2 (car (atomic-tp t2)))
+                        &aux (t1 (type-and #tinteger t1))(t2 (type-and #tinteger t2))(t3 (type-and #tinteger t3))
+                          (a1 (car (atomic-tp t1)))(a2 (car (atomic-tp t2)))
                           (a3 (car (atomic-tp t3))))
   (cond ((and a1 a2 a3) (object-type (funcall f a1 a2 a3)))
        ((type-and #t(not (integer 0 0)) (super-range '* #t(integer 0 1) (super-range 'min t1 t2))))))

diff --git a/cmpnew/gcl_lfun_list.lsp b/cmpnew/gcl_lfun_list.lsp
index 9e0aae07e802924b29ecad6464420e841ee5af64..2662dd08313a79a7682b7185e0707c73fdd9a2e7 100644 (file)
--- a/cmpnew/gcl_lfun_list.lsp
+++ b/cmpnew/gcl_lfun_list.lsp
@@ -18,6 +18,7 @@
 ;           (((t) t) . si::type-of-c)
 ;           (((list) t) . si::cons-car)
 ;           (((list) t) . si::cons-cdr)
+            (((structure) symbol) . structure-name)
             (((t t) cons) . cons)
             (((*) si::proper-list) . list)
             (((t *) list) . list*)
@@ -33,6 +34,7 @@
             (((real *) (returns-exactly real real)) . ceiling)
             (((real *) (returns-exactly real real)) . truncate)
             (((real *) (returns-exactly real real)) . round)
+            ((((or (integer 1) (float (0))) *) (or (integer 0) (float 0))) . random)
 ;           (((cons t) cons) . rplaca)
 ;           (((cons t) cons) . rplacd)
 ;           (((symbol) boolean) . boundp)

diff --git a/gcl-tk/guis.c b/gcl-tk/guis.c
index 9688c680e98e1da76821136c1c449ac95ea852b2..e8b88502c5a6f0137af324c5a818724457368ae5 100644 (file)
--- a/gcl-tk/guis.c
+++ b/gcl-tk/guis.c
@@ -273,7 +273,7 @@ char *envp[];
             {
                 dfprintf(stderr, "guis,vforked child : %d\n", p);
 
-                _exit(p);
+                _exit(0);
                 /*
                    return p;
                    */

diff --git a/gcl-tk/tkl.lisp b/gcl-tk/tkl.lisp
index 86d35c9a118c236e8cde2de3e6b46b77a1f0dd73..61314e58ee36dba69d3af78781cbd204058c661c 100644 (file)
--- a/gcl-tk/tkl.lisp
+++ b/gcl-tk/tkl.lisp
@@ -1487,18 +1487,15 @@ on ~a as in: ~s~%" host command )))
   (setf (msg-index) (the fixnum (+ m 1)))
   m)
 
-(defun get-autoloads (&optional (lis (directory "*.lisp")) ( out "index.lsp")
-                               &aux *paths*
-                               )
-  (declare (special *paths*))
+(defun get-autoloads (&optional
+                       (lis (sort (directory "*.lisp") 'string<= :key 'namestring))
+                       (out "index.lsp"))
   (with-open-file
    (st out :direction :output)
    (format st "~%(in-package ~s)" (package-name *package*))
    (dolist (v lis) (get-file-autoloads v st))
    (format st "~%(in-package ~s)" (package-name *package*))
-   ;(format st "~2%~s" `(setq si::*load-path* (append ',*paths* si::*load-path*)))
-
-   ))
+   (format st "~%(push (namestring (make-pathname :directory (pathname-directory *load-pathname*))) si::*load-path*)")))
 
 
                  
@@ -1506,16 +1503,10 @@ on ~a as in: ~s~%" host command )))
                                &aux (eof '(nil))
                                (*package* *package*)
                                saw-package
-                               name  )
-  (declare (special *paths*))
+                               name)
   (setq name (pathname-name (pathname file)))
   (with-open-file
    (st file)
-   (if (boundp '*paths*)
-       (pushnew (namestring (make-pathname :directory
-                                          (pathname-directory
-                                           (truename st))))
-               *paths* :test 'equal))
    (sloop for tem = (read st nil eof)
          while (not (eq tem eof))
          do (cond ((and (consp tem) (eq (car tem) 'defun))

diff --git a/git.tag b/git.tag
index 80fa1659a9f9149e6d0a3611891cf4d8b47c0712..e54678a41e1fb4b4e57a69cc8955dcb810551c89 100644 (file)
--- a/git.tag
+++ b/git.tag
@@ -1 +1 @@
-"Version_2_7_2pre35"
+"Version_2_7_2pre36"

diff --git a/h/386-macosx.h b/h/386-macosx.h
index d977a3e57b243a620c63dd9165b50f172a210170..d9f51dc689f6ff22d73186a22cd41c4dc4d9e892 100644 (file)
--- a/h/386-macosx.h
+++ b/h/386-macosx.h
@@ -115,7 +115,6 @@ do {                                                        \
  } while (0)
 
 #ifdef _LP64
-#define C_GC_OFFSET 4
 #include <mach-o/x86_64/reloc.h>
 #define RELOC_H "mach64_i386_reloc.h"
 #else

diff --git a/h/aarch64-macosx.h b/h/aarch64-macosx.h
index a110d19e04f59f46c1b01c3bbc4fb7b95572e5a2..eb7be4d5f99f3077c6cadab3625b549e74a0dd29 100644 (file)
--- a/h/aarch64-macosx.h
+++ b/h/aarch64-macosx.h
@@ -114,7 +114,6 @@ do {                                                        \
   (a_) = fub;                                              \
  } while (0)
 
-#define C_GC_OFFSET 4
 #include <mach-o/arm64/reloc.h>
 #define RELOC_H "mach64_aarch64_reloc.h"
 

diff --git a/h/amd64-kfreebsd.h b/h/amd64-kfreebsd.h
index 403ece2be5e5ccde5da41410731d7c789c516adf..6cb35f54e190aa92b99a9d7d19d02b997446061a 100644 (file)
--- a/h/amd64-kfreebsd.h
+++ b/h/amd64-kfreebsd.h
@@ -8,9 +8,6 @@
 #define        I386
 #define SGC
 
-/* Apparently stack pointers can be 4 byte aligned, at least &argc -- CM */
-#define C_GC_OFFSET 4
-
 #define RELOC_H "elf64_i386_reloc.h"
 
 #define BRK_DOES_NOT_GUARANTEE_ALLOCATION

diff --git a/h/amd64-linux.h b/h/amd64-linux.h
index 8d71728c2116e1b4b02ae00af77bd7855bd9dc47..4ccbfa5daa0510da0ada246de7d809348abfa493 100644 (file)
--- a/h/amd64-linux.h
+++ b/h/amd64-linux.h
@@ -7,9 +7,6 @@
 #define        I386
 #define SGC
 
-/* Apparently stack pointers can be 4 byte aligned, at least &argc -- CM */
-#define C_GC_OFFSET 4
-
 #define RELOC_H "elf64_i386_reloc.h"
 #define MAX_CODE_ADDRESS (1L<<31)/*large memory model broken gcc 4.8*/
 #define MAX_DEFAULT_MEMORY_MODEL_CODE_ADDRESS (1UL<<31)

diff --git a/h/att_ext.h b/h/att_ext.h
index 91f1cfa3aa4f334b8c95a9ab089c4239e44db8c9..18ef2eb60e76f78582919d1b243f69d73b53892c 100644 (file)
--- a/h/att_ext.h
+++ b/h/att_ext.h
@@ -171,6 +171,7 @@ EXTER char **ARGV;
 #ifdef UNIX
 EXTER char **ENVP;
 #endif
+EXTER struct stat ss;
 
 EXTER object sSAsystem_directoryA;
 #ifdef UNIX

diff --git a/h/loongarch64-linux.h b/h/loongarch64-linux.h
index b3745d241e1372532a4ec374cadd6ce0b39dfe80..aee2b6b26b5302371b0a21ba41dcb0d6cb59004d 100644 (file)
--- a/h/loongarch64-linux.h
+++ b/h/loongarch64-linux.h
@@ -2,9 +2,6 @@
 
 #define SGC
 
-/* Apparently stack pointers can be 4 byte aligned, at least &argc -- CM */
-#define C_GC_OFFSET 4
-
 #define RELOC_H "elf64_loongarch64_reloc.h"
 #define SPECIAL_RELOC_H "elf64_loongarch64_reloc_special.h"
 /* #define MAX_CODE_ADDRESS (1L<<31)/\*large memory model broken gcc 4.8*\/ */

diff --git a/h/pool.h b/h/pool.h
index bdb7e4b5e8ce0504760d24f67a0422b9719328f8..4f0ee91c6905fce19fb643da386168a9aa74c06e 100644 (file)
--- a/h/pool.h
+++ b/h/pool.h
@@ -63,7 +63,6 @@ open_pool(void) {
 
   if (pool==-1) {
 
-    struct stat ss;
     massert(!lstat(multiprocess_memory_pool,&ss));
     massert(S_ISDIR(ss.st_mode));
 

diff --git a/h/powerpc-linux.h b/h/powerpc-linux.h
index 8355c0db41d28fa0ec2c5d86bf45eacca99705ba..8896ffc154b179545f13ece840594ebc1f0d91ac 100644 (file)
--- a/h/powerpc-linux.h
+++ b/h/powerpc-linux.h
@@ -21,5 +21,4 @@
 #define SPECIAL_RELOC_H "elf64_ppcle_reloc_special.h"
 #endif
 #define OUTPUT_MACH bfd_mach_ppc64
-#define C_GC_OFFSET 4
 #endif

diff --git a/h/protoize.h b/h/protoize.h
index 4f31480438b3abd1393bec0652c192a7e03ba753..69569f4020de467ba7e48f4ef4abbc30cd40175e 100644 (file)
--- a/h/protoize.h
+++ b/h/protoize.h
@@ -1671,6 +1671,6 @@ object quick_call_function_vec(object,ufixnum,object *);
 int msbrk_initialized(void);
 void *mdlopen(const char *,int);
 void set_global_env_defaults(void);
-void disable_aslr(int,char **,char **);
+void maybe_disable_aslr(int,char **,char **);
 void set_leak_malloc_on(void);
 void set_leak_malloc_off(void);

diff --git a/h/riscv64-linux.h b/h/riscv64-linux.h
index 3fe9384d09bf3f68128e5198a33b39889b7699d7..5f184628a91e7155649eff3139199863526e54c9 100644 (file)
--- a/h/riscv64-linux.h
+++ b/h/riscv64-linux.h
@@ -2,9 +2,6 @@
 
 #define SGC
 
-/* Apparently stack pointers can be 4 byte aligned, at least &argc -- CM */
-#define C_GC_OFFSET 4
-
 #define RELOC_H "elf64_riscv64_reloc.h"
 /* #define MAX_CODE_ADDRESS (1L<<31)/\*large memory model broken gcc 4.8*\/ */
 

diff --git a/h/s390-linux.h b/h/s390-linux.h
index ea981ce52429bdfa5ce33aa7f3011076448da41d..21a8a11fafb77ca595d094ef312db09b52354646 100755 (executable)
--- a/h/s390-linux.h
+++ b/h/s390-linux.h
@@ -3,7 +3,6 @@
 #define SGC
 
 #if SIZEOF_LONG == 8
-#define C_GC_OFFSET 4
 #define RELOC_H "elf64_s390_reloc.h"
 #define SPECIAL_RELOC_H "elf64_sparc_reloc_special.h"
 #define OUTPUT_MACH bfd_mach_s390_64

diff --git a/h/sparc-linux.h b/h/sparc-linux.h
index ad33a3bd7fd1bdca5cf14a72c7c00ece3550f379..249d10159eb1978128f2c6d7b181c51a5427f42e 100755 (executable)
--- a/h/sparc-linux.h
+++ b/h/sparc-linux.h
@@ -14,8 +14,4 @@
 #define SPECIAL_RELOC_H "elf64_sparc_reloc_special.h"
 #endif
 
-/* #if SIZEOF_LONG == 8 */
-/* #define C_GC_OFFSET 4 */
-/* #endif */
-
 #define OUTPUT_MACH bfd_mach_sparc_v9

diff --git a/o/cmpaux.c b/o/cmpaux.c
index 6828dfa8845bd9c25efac51a3b202457610306b3..922b6a3e4afa0769b6ee424110442cb0b55c2a03 100644 (file)
--- a/o/cmpaux.c
+++ b/o/cmpaux.c
@@ -659,7 +659,6 @@ find_init_name1(char *s,unsigned len) {
   return find_init_string(tmp);
 
 #else    
-  struct stat ss;
   char *tmp,*q;
   FILE *f;
 

diff --git a/o/disable_aslr.c b/o/disable_aslr.c
index 61046967f68f11ab80699e9373354388a21f13c3..ccaad637cc544dc0047830abf5568b70b92ee748 100644 (file)
--- a/o/disable_aslr.c
+++ b/o/disable_aslr.c
@@ -1,7 +1,5 @@
 #include "include.h"
 
-#ifdef DISABLE_ASLR
-
 #if defined(__APPLE__)
 
 #include <stdio.h>
@@ -15,11 +13,16 @@
 #endif
 
 void
-disable_aslr(int argc, char **argv, char **envp) {
+maybe_disable_aslr(int argc, char **argv, char **envp) {
 
   pid_t pid;
   posix_spawnattr_t attr;
 
+#ifndef DISABLE_ASLR
+  if (!getenv("GCL_DISABLE_ASLR"))
+    return;
+#endif
+
   if (!_dyld_get_image_vmaddr_slide(0)) {
     return;
   }
@@ -88,11 +91,16 @@ reexec(int argc, char **argv, char **envp) {
 #include <unistd.h>
 
 void
-disable_aslr(int argc, char **argv, char **envp) {
+maybe_disable_aslr(int argc, char **argv, char **envp) {
 
   long pers;
   long flag = ADDR_NO_RANDOMIZE|(sizeof(flag)==4 ? ADDR_COMPAT_LAYOUT : 0);
 
+#ifndef DISABLE_ASLR
+  if (!getenv("GCL_DISABLE_ASLR"))
+    return;
+#endif
+
   massert((pers=personality(-1))!=-1);
 
   /*READ_IMPLIES_EXEC is for selinux, but selinux will reset it in the child*/
@@ -114,11 +122,16 @@ disable_aslr(int argc, char **argv, char **envp) {
 #include <sys/procctl.h>
 
 void
-disable_aslr(int argc, char **argv, char **envp) {
+maybe_disable_aslr(int argc, char **argv, char **envp) {
 
   const int cctl=PROC_ASLR_FORCE_DISABLE;
   int stat,ctl=cctl;
 
+#ifndef DISABLE_ASLR
+  if (!getenv("GCL_DISABLE_ASLR"))
+    return;
+#endif
+
   massert(procctl(P_PID, 0, PROC_ASLR_STATUS, &stat) != -1);
 
   if ((stat&cctl)!=cctl && !getenv("GCL_UNRANDOMIZE")) {
@@ -136,12 +149,10 @@ disable_aslr(int argc, char **argv, char **envp) {
 #else  /*Unneeded on Hurd, cygwin/mingw via coff header flag*/
 
 void
-disable_aslr(int argc, char **argv, char **envp) {
+maybe_disable_aslr(int argc, char **argv, char **envp) {
   return;
 }
 
 #endif
 
 #endif
-
-#endif

diff --git a/o/file.d b/o/file.d
index c1f9f9f8cfe2d5382eb769bc300418335ed38e5c..acc5ec5fbebec9e356945591a0a7116e6ba7a003 100644 (file)
--- a/o/file.d
+++ b/o/file.d
@@ -257,7 +257,6 @@ open_stream(object fn,enum smmode smm, object if_exists, object if_does_not_exis
 
     if (!(fp=*FN1=='|' ? popen(FN1+1,"r") : fopen_not_dir(FN1,"r")) && sSAallow_gzipped_fileA->s.s_dbind!=Cnil) {
 
-      struct stat ss;
       massert(snprintf(FN2,sizeof(FN2),"%s.gz",FN1)>0);
 
       if (!stat(FN2,&ss)) {

diff --git a/o/gprof.c b/o/gprof.c
index ecf3736888583edfe2aea7384cea12e20d0aaa2e..399881d6b6a229a6d9dc20ea47e30347fc9e7a19 100644 (file)
--- a/o/gprof.c
+++ b/o/gprof.c
@@ -1,9 +1,21 @@
+#include <dlfcn.h>
+
 #include "include.h"
 #include "page.h"
 #include "ptable.h"
 
-
 static unsigned long gprof_on;
+static void (*real_mcount)(void);
+
+void __attribute__((no_instrument_function))
+mcount(void) {
+
+  if (__builtin_expect(!gprof_on,1))
+    return;
+
+  real_mcount();
+
+}
 
 /*all but this stub to be written in the future provided*/
 #if defined(__APPLE__)
@@ -44,6 +56,8 @@ DEFUN("MONSTARTUP",object,fSmonstartup,SI,2,2,NONE,OI,IO,OO,OO,(ufixnum start,uf
     return Cnil;
 
   writable_malloc_wrap(my_monstartup,int,start,end);
+  if (__builtin_expect(!real_mcount,0))
+    massert(real_mcount=dlsym(RTLD_NEXT,"mcount"));
   gprof_on=1;
 
   return Ct;
@@ -54,6 +68,7 @@ void
 gprof_cleanup(void) {
 
   FFN(fSmcleanup)();
+  real_mcount=NULL;
 
 }
 

diff --git a/o/hash.d b/o/hash.d
index d3d8c41ba602dfbd3f9895d0329c3eb604e15317..616d94745e63afec43840cd7e2fdf5cafb68c0e5 100644 (file)
--- a/o/hash.d
+++ b/o/hash.d
@@ -79,7 +79,7 @@ static ufixnum
 ufixhash(ufixnum g) {
   ufixnum i,h;
   for (h=i=0;i<sizeof(g);g>>=CHAR_SIZE,i++)
-    h^=rtb[g&MASK(CHAR_SIZE)];
+    h^=rtb[(g+i)&MASK(CHAR_SIZE)];
   return h;
 }
 
@@ -200,11 +200,11 @@ BEGIN:
 
        for (;u<ue;) {
          ufixnum v=(*u++)>>s;
-         if (u<ue||m) {
+         if (s&&(u<ue||m)) {
            ufixnum w=(*u);
            if (u==ue)
              w&=BIT_MASK(m);
-           v|=w<<(sizeof(*u)-s);
+           v|=w<<(BV_BITS-s);
          }
          h^=ufixhash(v);
        }
@@ -276,11 +276,11 @@ BEGIN:
 
        for (;u<ue;) {
          ufixnum v=(*u++)>>s;
-         if (u<ue||m) {
+         if (s&&(u<ue||m)) {
            ufixnum w=(*u);
            if (u==ue)
              w&=BIT_MASK(m);
-           v|=w<<(sizeof(*u)-s);
+           v|=w<<(BV_BITS-s);
          }
          h^=ufixhash(v);
        }

diff --git a/o/main.c b/o/main.c
index 9ac5f038e2b4960b663402f5e49c26e82c3e77b4..2b2ce21c77390b4915e790aa3d534add96e21def 100644 (file)
--- a/o/main.c
+++ b/o/main.c
@@ -380,6 +380,8 @@ get_gc_environ(void) {
   }
 
   multiprocess_memory_pool=getenv("GCL_MULTIPROCESS_MEMORY_POOL");
+  if (multiprocess_memory_pool && !*multiprocess_memory_pool)
+    multiprocess_memory_pool=NULL;
   if (multiprocess_memory_pool &&
       (*multiprocess_memory_pool=='t' || *multiprocess_memory_pool=='T'))/*GCL 2.6 compatability*/
     multiprocess_memory_pool=getenv("HOME");
@@ -705,9 +707,7 @@ DEFUN("KCL-SELF",object,fSkcl_self,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
 int
 main(int argc, char **argv, char **envp) {
 
-#ifdef DISABLE_ASLR
-  disable_aslr(argc,argv,envp);
-#endif
+  maybe_disable_aslr(argc,argv,envp);
 
 #include "cstack.h"
 

diff --git a/o/save.c b/o/save.c
index 4bf3ed1abc2dd9faa7784f2b8034c7eb8f9975c0..688305c32e14a6cf384cc76d0710b498313e89e7 100644 (file)
--- a/o/save.c
+++ b/o/save.c
@@ -39,6 +39,7 @@ LFD(siLsave)(void) {
   set_global_env_defaults();
   shared_lib_start=NULL;
   memset(&fcall,0,sizeof(fcall));
+  memset(&ss,0,sizeof(ss));
   memset(gmp_jmp,0,sizeof(gmp_jmp));
   memset(stdin_buf,0,sizeof(stdin_buf));
   memset(stdout_buf,0,sizeof(stdout_buf));

diff --git a/o/unixfsys.c b/o/unixfsys.c
index 42b98cf10423408f9b681bf5c7b3428a57e2ac9c..490dfe6cadca6c1ec8e9058879c238511fb2fadd 100644 (file)
--- a/o/unixfsys.c
+++ b/o/unixfsys.c
@@ -173,8 +173,6 @@ fShome_namestring(object x) {
 FILE *
 fopen_not_dir(char *filename,char *option) {
 
-  struct stat ss;
-
   return DIR_EXISTS_P(filename,ss) ? NULL : fopen(filename,option);
 
 }
@@ -182,17 +180,13 @@ fopen_not_dir(char *filename,char *option) {
 int
 file_len(FILE *fp) {/*FIXME dir*/
 
-  struct stat filestatus;
-
-  return fstat(fileno(fp), &filestatus) ? 0 : filestatus.st_size;
+  return fstat(fileno(fp), &ss) ? 0 : ss.st_size;
 
 }
 
 bool
 file_exists(object x) {
 
-  struct stat ss;
-
   coerce_to_filename(x,FN1);
 
   return FILE_EXISTS_P(FN1,ss) ? TRUE : FALSE;
@@ -232,8 +226,6 @@ stat_mode_key(struct stat *ssp) {
 
 DEFUN("STAT1",object,fSstat1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
 
-  struct stat ss;
-
   RETURN1(stat_internal(x,&ss) ? stat_mode_key(&ss) : Cnil);
 
 }
@@ -243,7 +235,6 @@ DEFUNM("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
 
   object *vals=(object *)fcall.valp;
   object *base=vs_top;
-  struct stat ss;
 
   if (stat_internal(x,&ss))
     RETURN4(stat_mode_key(&ss),
@@ -372,8 +363,7 @@ DEFUN("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,obje
 #define get_d_type(e,s) e->d_type
 #else
 #define get_d_type(e,s) \
-  ({struct stat ss;\
-    massert(snprintf(FN1,sizeof(FN1),"%-*.*s%s",s->st.st_fillp,s->st.st_fillp,s->st.st_self,e->d_name)>=0);\
+  ({massert(snprintf(FN1,sizeof(FN1),"%-*.*s%s",s->st.st_fillp,s->st.st_fillp,s->st.st_self,e->d_name)>=0);\
     lstat(FN1,&ss);S_ISDIR(ss.st_mode) ? DT_DIR : DT_REG;})
 #endif
 
@@ -517,7 +507,6 @@ get_mmap_flags(FILE *fp,void **ve,int flags) {
 
   int n;
   void *v1;
-  struct stat ss;
 
   massert((n=fileno(fp))>2);
   massert(!fstat(n,&ss));

diff --git a/unixport/sys.c b/unixport/sys.c
index 260607c112d55342812dc43c9074e63f6cd0bf94..be38b6fcf21804ec57d9f5477e1baf6251e4816f 100644 (file)
--- a/unixport/sys.c
+++ b/unixport/sys.c
@@ -23,8 +23,6 @@
 static void
 ar_init_fn(void (fn)(void),const char *s) {
 
-  struct stat ss;
-  
   if (stat(s,&ss)) {
 
     char *sysd=getenv("GCL_SYSDIR");